perm filename PXMOVF.FAI[RST,LCS] blob sn#179208 filedate 1975-09-28 generic text, type T, neo UTF8
00100		TITLE PTMOVF; ********* JUN 8,74 *********
00200		INTERNAL LOOK,LOOKD,LOOKF
00300		ENTRY	GETPTS,MOVIT,EXTEN
00400	DEFINE ERROR (MSG)
00500	<	JSA 16,.ERROR
00600		JUMP [ASCIZ/MSG/
00700	]
00800	>
00900	
01000	.ERROR:	0
01100		OUTSTR [ASCIZ/?
01200	/]				;MAKE SURE HE CAN SEE HIS ERROR
01300		OUTSTR @(16)		;OUTPUT ERROR MESSAGE
01400		CALLI 1,12		;LET USER CONTI2UE
01500		JRA 16,1(16)
01600	
01700		CH←13
01800	
01900	REGS:	BLOCK 20
02000	
02100	;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
02200	
02300	LOOKF:	0
02400		MOVSI 0,'DMD'
02500		JRST LOOK1
02600	LOOKD:	0
02700		MOVSI 0,'DAT'
02800		JRST LOOK1
02900	LOOK:	0
03000		MOVEI	0,0
03100	LOOK1:	MOVEM	0,DIR+1
03200		MOVE	0,@(16)
03300		MOVEM 	0,FILNAM
03400		JSA 16, INTFIQ
03500		SETZM	DIR+2
03600		SETZM	DIR+3
03700		LOOKUP	CH,DIR
03800		TDZA	0,0
03900		MOVNI	0,1
04000		JRA 16,1(16)
04100	
04200	INTFIQ:	0	;INITS DSK FOR INPUT
04300		MOVEI REGS
04400		BLT REGS+3
04500		INIT CH,17
04600		SIXBIT/DSK/
04700		0
04800		HALT .-3
04900	;	ERROR <CAN'T INIT DSK!>
05000	
05100	INTF4:	MOVE 0,FILNAM#
05200		MOVEM 0,FN#
05300		MOVE 1,[POINT 7,FN]
05400	INTF3:	MOVE 2,[POINT 6,DIR]
05500		SETZM DIR
05600		MOVEI 3,5
05700	INTF1:	ILDB 0,1
05800		CAIN 0," "
05900		JRST INTF2
06000		SUBI 0,40
06100		IDPB 0,2
06200		SOJG 3,INTF1
06300	INTF2:	HRLZI REGS
06400		BLT 3
06500		JRA 16,0(16)
06600	
06700	DIR:	BLOCK 4
06800		EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP
06900	
07000	  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
07100		DEFINE FIXX(N)
07200	<	JUMPGE	N,.+5
07300		MOVNS	N
07400		FIX 	N,233000    
07500		MOVNS	N
07600		CAIA
07700		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
07800	
07900	; 	SUBROUTINE GETPTS
08000	;	COMMON/KNR/N(500) /NNP/NP(500)
08100	;	COMMON/XRN/RN(4000)  /KJY/ K,J
08200	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
08300	;	1/PTR/PWDS(250),ITEM,LL,I,IX
08400	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
08500	;	1,(R6,RJQ(4))
08600	
08700	GETPTS:	0		;CALL GETPTS(N,RN,PWDS)
08800		SETZ	J,	;	J=0
08900		SETZ	K,	;	K=0
09000		MOVE 	JJ2,POSI+=8
09100		MOVE	R2,.COMM.
09200		SETZ	X,
09300	;;	MOVE	X,@(16)
09400	;;	SOJ	X
09500		MOVEI 	M,@2(16);	DO 1 M=1,ITEM
09600		ADDI	M,(X)
09700	G1:	AOJ	X,
09800		MOVE	L,(M)
09900		FIXX(L)
10000		MOVEI 	R,@1(16)	;L=PWDS(M)
10100		ADDI	R,(L)		;IF(RTLINE(L))GO TO 1
10200	;*	MOVE	1,1(R)		;RN(L+2)
10300	;;NEVER USED IN 'PARTS'-	CAML	R2,[=5.0]
10400	;;	JRST	GZ
10500		CAME	R2,1(R)
10600		JRST 	GX
10700	GZ:	MOVE	A,.COMM.+7		;RY=RN(L+1)
10800		JUMPLE	A,G9			;F(R6.LE.0)GO TO 9
10900		CAME	A,(R)		;IF(R6.NE.RY)GO TO 1
11000		JRST	GX
11100	;  CHECK CODE NUM
11200	G9:	MOVE	A,2(R)
11300		CAMLE	A,.COMM.+6	;R5
11400		JRST	G2	;9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
11500		CAMGE	A,.COMM.+5	;R4
11600		JRST	G2
11700	
11800		SKIPG	JJ2
11900		MOVE	JJ2,X
11910		MOVE	.COMM.+=8	;RN(L+2)=R7
11920		MOVEM	1(R)
12000		AOJ	J,
12100	;  IN LIMITS?
12200	;	MOVEI	A,XRN+=2498	;J=J+1
12300	;;	MOVEI	A,KNR-1
12400	;;	ADDI	A,(J)
12500		MOVEI	0,(L)
12600		AOJ	K,		;K=K+1
12800	;;	MOVEI	1,NNP-1
12900	;;	ADDI	1,(K)		;NP(K)=L
13000		MOVEM	0,NNP-1(K)
13100		ADDI	0,3		;N(J)=L+3
13200		MOVEM	0,KNR-1(J)
13300	;  NP IS FOR USE IN JUSTIFY ROUTINE
13400	G2:	MOVE	RY,(R)	;2	IF(RY.LT.4)GO TO 1
13500		CAMGE	RY,[=4.0]
13600		JRST	GX
13610		CAMN	RY,[=44.0]	;CODE 4 IS SOMETIMES =44
13620		JRST	G5		;FOUND A LINE
13700		CAMLE	RY,[=7.0]
13800		JRST	GX		;IF(RY.GT.7)GO TO 1
13900	;  TWO-ENDED ITEM?
14000		MOVE	RZ,-1(R)	;RZ=RN(L)
14100	;  WD CNT
14200	;;	CAMN	RY,[=4.0]	;GO TO(4,5,6,7),IFIX(RY)-3
14300	;;	JRST	G4
14400	;;	CAMN	RY,[=5.0]
14500	;;	JRST	G5
14600	;;	CAMN	RY,[=6.0]
14700	;;	JRST	G6
14800	;;	CAMG	RZ,[=4.0]	;4	IF(RZ.GT.2)GO TO 5
14900	;;	JRST	G5		; THERE IS A TRILL WIGGLE
15000	;;	JRST	GX		;GO TO 1   -- NO WIGGLE (P7≠0)
15010		FIXX(RY)
15020		XCT TBL-4(RY)	; NEXT REPLACES THE ABOVE.
15030		JRST G5
15040		JRST GX
15050	TBL:	JRST G4
15060		JRST G5
15070		JRST G6
15080		CAMG RZ,[4.0]
15090	
15100	G4:	CAMG	RZ,[=2.0]	;7	IF(RZ.GT.3)GO TO 5
15200		JRST	GX
15300		JRST	G5		;GO TO 1
15400	G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
15500		JRST	G8
15600	;;	MOVEI	1,XRN		;IF(RN(L+10).LT.30)GO TO 8
15700	;;	ADDI	1,(L)
15800	;;	MOVE	1,11(1)
15900		MOVE	1,=9(R)
16000		CAMGE	1,[=30.0]
16100		JRST	G8
16200		MOVE	A,7(R)	  ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
16300		CAMLE	A,.COMM.+6
16400		JRST	G8
16500		CAMGE	A,.COMM.+5
16600		JRST	G8
16700		SKIPG	JJ2
16800		MOVE	JJ2,X
16900		AOJ	J,
17000	;  IN LIMITS?
17100	;	MOVEI	A,XRN+=2498	;J=J+1
17300	;	ADDI	A,(J)
17400		MOVEI	0,8(L)		;J=J+1
17500	;;	ADDI	0,=8		;N(J)=L+8
17600		MOVEM	0,KNR-1(J)
17700	G8:	CAMGE	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
17800		JRST 	G5
17900	;;	MOVE	A,6(R)		;IF(RN(L+7))GO TO G8B
18000	;;	JUMPL	A,G8B		; P7 IS NEG FOR TREMOLO
18100	;;	MOVE	A,7(R)		;IF(RN(L+8).NE.0)GO TO G8B
18200	;;	JUMPN	A,G8B
18210		SKIPL 6(R)
18220		SKIPE 7(R)
18230		JRST  G8B
18240	
18300		CAMGE	RZ,[=8.0]
18400		JRST	G5		;IF(RZ.LT.8)GO TO G5
18500		MOVE	A,=9(R)		;IF(RN(L+10).EQ.0)GO TO G5
18600		JUMPE	A,G5		;PASSES NUMBER OVER BEAM.
18700	G8B:	MOVE	A,8(R)
18800		CAMLE	A,.COMM.+6
18900		JRST	G5
19000		CAMGE	A,.COMM.+5	;R4
19100		JRST	G5
19200	
19300		SKIPG	JJ2
19400		MOVE	JJ2,X
19500		AOJ	J,		;J=J+1
19600	;  IN LIMITS?
19700	;	MOVEI	A,XRN+=2498	;J=J+1
19900	;	ADDI	A,(J)
20000		MOVEI	0,=9(L)
20100	;;	ADDI	0,=9		;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
20200		MOVEM	0,KNR-1(J)	;N(J)=L+9
20300	G5:	MOVE	A,5(R)
20400		CAMLE	A,.COMM.+6
20500		JRST	GX
20600		CAMGE	A,.COMM.+5	;R4
20700		JRST	GX
20800	
20900		SKIPG	JJ2
21000		MOVE	JJ2,X
21100		AOJ	J,
21200	;  IN LIMITS?
21300	;|	MOVEI	A,XRN+=2498	;J=J+1
21500	;;	ADDI	A,(J)
21600		MOVEI	0,6(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
21700	;;	ADDI	0,6		;N(J)=L+6
21800		MOVEM	0,KNR-1(J)
21900	GX:	CAMGE	X,PTR+=250	;1	CONTINUE
22000		AOJA	M,G1
22100		MOVEM	JJ2,POSI+=8
22200		MOVEM	J,KJY+1
22300		MOVEM	K,KJY
22400		JRA	16,3(16)
22500	
22600	;	SUBROUTINE MOVIT(RN)
22700	;	COMMON /KNR/ N(500)
22800	;	COMMON  /KJY/ DONT,J
22900	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
23000	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
23100	;	1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
23200	MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
23300		MOVE	R,.COMM.+=10
23400		FSBR	R,.COMM.+=9
23500		MOVE	RY,.COMM.+6
23600		FSBR	RY,.COMM.+5
23700		FDVR	R,RY
23800	;	MOVEI	L,XRN+=2499	;	DO 1 K=1,J
23900		MOVEI	L,KNR
24000		SETZ	K,
24100		MOVE	0,.COMM.+=10	; SET UP R9
24200	;;M1:	MOVE	X,L	       ;	L=N(K)
24300	;;	MOVE	A,(X)
24350	M1:	MOVE	A,(L)
24400		MOVEI  	R2,@(16)	;RA=RN(L)
24500		ADDI	R2,(A)
24600		MOVEI	RZ,(R2)
24700		MOVE	R2,-1(R2)
24800		CAMGE	R2,.COMM.+5	;IF(OUTLIM(R4,R5,RA))GO TO 1
24900		JRST 	MX
25000		CAMLE	R2,.COMM.+6
25100		JRST	MX
25200		JUMPE	0,M2	;IF(R9.NE.0)RA=(RA-R4)*RDIS
25300		FSBR	R2,.COMM.+5
25400		FMPR	R2,R 
25500	M2: 	FADR	R2,.COMM.+=9	;	RN(L)=R8+RA
25600		MOVEM	R2,-1(RZ)
25700	MX:	AOJ	K,		;1	CONTINUE
25800		CAMGE	K,KJY+1
25900		AOJA	L,M1
26000		JRA	16,1(16)
26100	
26200	EXTEN:	0	;FUNCTION EXTEN(X)
26300		HRRM	16,.+2
26400		JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
26500		JUMP 	@0
26600		JUMP	[=1.0]
26700		FMPR	[=10.0]
26800		JRA	16,1(16)
26900	
29400		END